home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / STARS3D.ZIP / 3DSTAR.PAS next >
Encoding:
Pascal/Delphi Source File  |  1995-12-22  |  4.2 KB  |  160 lines
  1. Uses Crt,Mcga;
  2. {$I C:\Pas\Fonts.Fnt}  {Hand Drawn Font File Done By Fonted Ver 1.1}
  3. Type
  4.     Star = Record
  5.          X,
  6.          Y,           {Easiest Way To Create 300 Stars}
  7.          Z : Integer;
  8. end;
  9.  
  10.  
  11. Var
  12.    Stars : Array[1..300] Of Star;
  13.    X,Y,Loop,Ypos,Ypos1 : Word;
  14.    Pos : Array[1..300] Of Star;
  15.    Time : Byte;
  16.  
  17. Procedure Setup;
  18. Begin
  19.      For Loop := 1 To 300 Do
  20.      Begin
  21.           Stars[Loop].X := Random(320)-160; {Values Of -160 To +160}
  22.           Stars[Loop].Y := Random(200)-100; {Values Of -100 To +100}
  23.           Stars[Loop].Z := Loop;
  24.      end;
  25. end;
  26.  
  27. Procedure Calc;
  28. Begin
  29.      For Loop := 1 To 300 Do
  30.      Begin
  31.           Pos[Loop].X := Stars[Loop].X * 100 Div Stars[Loop].Z+160;
  32.           Pos[Loop].Y := Stars[Loop].Y * 100 Div Stars[Loop].Z+100;
  33.      end;
  34. end;
  35.  
  36. Procedure MoveStars;
  37. Begin
  38.      For Loop := 1 To 300 Do
  39.      Begin
  40.           Dec(Stars[Loop].Z,4);
  41.           If Stars[Loop].Z < 1 Then Inc(Stars[Loop].Z,Loop+4);
  42.      end;
  43. end;
  44.  
  45. Procedure Border; {Draws 2 Lines}
  46. Var Loop,Loop1,Col : Word;
  47. Begin
  48.          For Loop := 1 To 319 Do
  49.          PutPixel(Loop,Ypos,100,VirAddr);
  50.  
  51.          For Loop := 1 To 319 Do
  52.          PutPixel(Loop,Ypos1,100,VirAddr);
  53.  
  54.          {Slow But Not As Slow As Last Time - Just Draws A Line}
  55.          {Instead Of Drawing Black Border To Line}
  56.          {This Sets A Sort Of Drawing Window Frame}
  57.  
  58.          Flip;
  59.  
  60. end;
  61.  
  62. Procedure Logo;
  63. Begin
  64.      {Sloppy But Hey It Works}
  65.  
  66.      Inc(Time);
  67.      If Time < 63 Then SetPal(1,0,0,Time);
  68.      If Time < 63 Then PutMsg(78,70,'A STARFIELD');
  69.      If Time = 63 Then SetPal(1,0,0,0);
  70.      If (Time > 63) And (Time <126) Then PutMsg(78,138,'BY');
  71.      If (Time > 63) And (Time < 126) Then SetPal(1,0,0,Time-62);
  72.      If (Time > 126) And (Time <180) Then SetPal(1,0,0,Time-125);
  73.      If (Time > 126) And (Time <280) Then PutMsg(78,64,'THE DARKMAN');
  74. end;
  75.  
  76.  
  77. Procedure DrawStars;
  78. Begin
  79.      For Loop := 1 To 300 Do
  80.      Begin
  81.           X := Pos[Loop].X;
  82.           Y := Pos[Loop].Y;
  83.  
  84.           If (X>1) And (X<320) And (Y>1) And (Y<Ypos1) And (Y>Ypos) Then Begin
  85.           {Only Draws Within The Current Ypos/Ypos1 Window}
  86.           If Pos[Loop].X <1 Then Inc(Pos[Loop].X,160);
  87.           If Pos[Loop].X > 320 Then Dec(Pos[Loop].X,160);
  88.           If Pos[Loop].Y <1 Then Inc(Pos[Loop].Y,100);
  89.           If Pos[Loop].Y >200 Then Dec(Pos[Loop].Y,100);
  90.           {Different Star Shades}
  91.           If Stars[Loop].Z > 400 Then PutPixel(X,Y,1,VirAddr) else
  92.           If Stars[Loop].Z > 300 Then PutPixel(X,Y,2,VirAddr) else
  93.           If Stars[Loop].Z > 200 Then PutPixel(X,Y,3,VirAddr) else
  94.           If Stars[Loop].Z > 100 Then PutPixel(X,Y,4,VirAddr) else
  95.           PutPixel(X,Y,5,VirAddr);
  96.      end;
  97. end;
  98.      {Flip;}
  99. end;
  100.  
  101. Begin
  102.      Ypos := 100; Ypos1 := 100;
  103.      ClrScr;
  104.      Writeln('Darius Sutherland / The Darkman Presents A 3D StarField With Various Affects');
  105.      Writeln('Main Coder - Darius The Darkman Sutherland');
  106.      Writeln('GFX        - Darius The Darkman Sutherland');
  107.      Writeln('Sound      - N/A');
  108.      Writeln;
  109.      Writeln('Old Versin      10 12.95');
  110.      Writeln('Updated Version 22.12.95');
  111.      Readkey;
  112.  
  113.      Gmode;
  114.      setpal(100,40,50,60);
  115.      {SetPal(1,5,5,15);} SetPal(2,10,10,20);
  116.      SetPal(3,20,20,30); SetPal(4,30,30,50);
  117.      SetPal(5,50,50,60);
  118.      SetPal(1,0,0,0);
  119.  
  120.      Border;
  121.      Delay(700);
  122.  
  123.      Setup;
  124.      DrawStars;
  125.      Calc;
  126.  
  127.      REPEAT
  128.      Calc;
  129.      If Time < 280 Then Logo;
  130.      DrawStars;
  131.      MoveStars;
  132.      If Ypos > 10 Then Dec(Ypos,5);
  133.      If Ypos1 < 190 Then Inc(Ypos1,5);
  134.      Border;
  135.      Clscr(0);
  136.      UNTIL KeyPressed;
  137.  
  138.      REPEAT                                     {^Long Winded Way Of Doing It}
  139.      Calc;
  140.      If Ypos < 100 Then Inc(Ypos,6);
  141.      If Ypos1 > 100 Then Dec(Ypos1,6);
  142.      DrawStars;
  143.      MoveStars;
  144.      Border;
  145.      Clscr(0);
  146.      UNTIL Ypos >= 100;
  147.  
  148.      Tmode;
  149.      Writeln('Greetz Go To : ');
  150.      Writeln;
  151.      Writeln('Mathew Nemesis Thomas');
  152.      Writeln('Grant Smith / Denthor');
  153.      Writeln('Alex Evans / Statix');
  154.      Writeln;
  155.      Writeln('Fonts Drawn By Darius Sutherland Using Fonted Beta Version By Him');
  156.      Writeln('Fonted Should Be Available On Ftp.Cdrom.Com /Pub/Demos/Incoming');
  157. end.
  158.  
  159.  
  160.